home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 001 / wwiv.arc / PART2.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1986-04-21  |  40.0 KB  |  1,162 lines
  1. overlay function getuser:boolean;
  2. var tries:integer; pasw,phone:str; done,nu,ok:boolean;
  3. begin
  4.   macok:=false; nu:=false;
  5.   window(1,5,80,25);
  6.   echo:=true;nl;nl;nl;nl;nl;
  7.   pasw:='';
  8.   printfile('gfiles\welcome.msg');
  9.   tries:=0;
  10.   repeat
  11.     repeat
  12.       print('Enter number or name or "NEW"');
  13.       prompt('NN: '); finduser(usernum);
  14.       if usernum=0 then tries:=tries+1;
  15.     until (tries=3) or hangup or (usernum<>0);
  16.     if tries>=3 then hangup:=true;
  17.     ok:=true; done:=false;
  18.     if usernum=-1 then begin
  19.       done:=true; ok:=false;
  20.       if incom and systat.closedsystem then begin
  21.         printfile('gfiles\system.msg');
  22.         printfile('gfiles\nonewusr.msg');
  23.         if not hangup then delay(5000); pasw:='';
  24.         while not empty do pasw:=pasw+inkey;
  25.         {if pasw=#14+#21 then nu:=true else}
  26.         hangup:=true;
  27.       end else
  28.         nu:=true;
  29.     end else begin
  30.       echo:=false; reset(uf); seek(uf,usernum); read(uf,thisuser);
  31.       topscr; mcursor;
  32.       prompt('PW: '); input(pasw,8);
  33.       prompt('PH: ###-###-'); input(phone,4); echo:=true;
  34.       if (thisuser.pw<>pasw) or (copy(thisuser.ph,9,4)<>phone) then begin
  35.         nl; print(chr(7)+'ILLEGAL LOGON'+CHR(7)); nl;
  36.         if (not hangup) and (usernum<>0) then sl1('### ILLEGAL LOGON USER #'+cstr(usernum));
  37.         thisuser.illegal:=thisuser.illegal+1; seek(uf,usernum);
  38.         write(uf,thisuser);
  39.         ok:=false; tries:=tries+1; if tries>=3 then hangup:=true;
  40.       end else done:=true;
  41.       if (thisuser.sl=255) and ok and incom and not hangup then begin echo:=false;
  42.         prompt(':'); input(pasw,8); echo:=true; if pasw<>systat.sysoppw then begin
  43.           nl;print(chr(7)+'ILLEGAL LOGON'+chr(7)); nl; ok:=false;
  44.           sl1('$$$$ ILLEGAL SYSOP SECOND PW $$$$'); done:=false;
  45.           tries:=tries+1; if tries>=3 then hangup:=true;
  46.         end;
  47.       end;
  48.       close(uf);
  49.     end;
  50.   until hangup or done;
  51.   if not (nu or hangup) then begin
  52.     if (rlogon in thisuser.ac) and (thisuser.laston=date) then begin
  53.       print('You can only log on once per day.');
  54.       hangup:=true; sl1(thisuser.name+' #'+cstr(usernum)+' tried logging on');
  55.     end;
  56.     if tries=3 then hangup:=true;
  57.   end;
  58.   getuser:=nu;
  59. end;
  60.  
  61. overlay procedure readmail;
  62. var pl,i,i1,mc,x,nmf:integer; c:char; abort,next:boolean; mr:mailrec; a:boolean;
  63.   filevar:file; ii,is:str;
  64. begin
  65.   nl; helpl:='M';
  66.   if thisuser.waiting=0 then print('You have no mail.') else begin
  67.     reset(mailfile);pl:=filesize(mailfile);
  68.     if thisuser.waiting>1 then begin
  69.       reset(uf);nl;
  70.       print('Mail summary: :'+cstr(thisuser.waiting)+': pieces:'); mc:=0;
  71.       i:=0; i1:=1; while (i<filesize(mailfile)) and not hangup do begin
  72.         seek(mailfile,i); read(mailfile,mr); if mr.destin=usernum then
  73.          if (mr.from<=0) and not (emailn in seclev[thisuser.sl].anst)
  74.           then begin print(cstr(i1)+': >UNKNOWN<'); mc:=mc+1; end else begin
  75.           seek(uf,abs(mr.from)); read(uf,user); print(''+cstr(i1)+' :'+user.name+
  76.           ' #'+cstr(abs(mr.from))); i1:=i1+1; mc:=mc+1;
  77.         end;
  78.         i:=i+1;
  79.       end;
  80.       close(uf);nl;nl;
  81.       print('Hit <ENTER> to read mail'); input(ii,2);nl;nl;
  82.       thisuser.waiting:=mc; if usernum=1 then fw:=mc;
  83.     end;
  84.     i:=0; nmf:=0;
  85.     repeat
  86.       abort:=false;
  87.       if i<=filesize(mailfile)-1 then begin seek(mailfile,i); read(mailfile,mr); end;
  88.       while (i<filesize(mailfile)-1) and (mr.destin<>usernum) do begin
  89.         i:=i+1; seek(mailfile,i); read(mailfile,mr);
  90.       end;
  91.       if (mr.destin=usernum) and (i<=filesize(mailfile)-1) then begin
  92.       nmf:=nmf+1;
  93.       repeat
  94.         a:=false; if emailn in seclev[thisuser.sl].anst then a:=true;
  95.         irt:='Your previous letter';
  96.         nl; if mr.title<>'' then print('Title: '+mr.title); irt:=mr.title;
  97.         if irt='' then irt:='Your previous letter';
  98.         readmsg(mr.msg,a,next); next:=false; tleft;
  99.         repeat
  100.           nl;prompt('Mail: D,I,R,A,? :');
  101.           if cs then onek(c,'ZDIRAV?') else onek(c,'DIRA?');
  102.           case c of
  103.             'I':next:=true;
  104.             '?':begin
  105.                   print('D:elete     I:gnore');
  106.                   print('R:e-read    A:uto-reply');
  107.                 end;
  108.             'A','D','Z':begin
  109.                       if c<>'Z' then ssm(abs(mr.from),nam+' read your letter on '+date);
  110.                       is:=rmail(i); next:=true; nmf:=nmf-1;
  111.                       thisuser.waiting:=thisuser.waiting-1;
  112.                       topscr;
  113.                     end;
  114.             'V':if cs then vallastuser;
  115.           end;
  116.           if c='A' then begin close(mailfile); autoreply; reset(mailfile); end;
  117.         until (C IN ['D','I','R','A','Z']) or hangup;
  118.       until next or hangup;
  119.       i:=i+1;
  120.     end else i:=i+1;
  121.     until (i>filesize(mailfile)-1) or hangup;
  122.     close(mailfile); if not hangup then thisuser.waiting:=nmf;
  123.   end;
  124. end;
  125.  
  126. overlay procedure vote;
  127. var vdata:file of vdatar; vd:vdatar; int,int2:integer; i,i1,ij:str; abort,next,done,lq:boolean;
  128.  
  129. procedure vote1(qnum:integer);
  130. var cv,tv,ii:integer; i,i1,i2:str; c:char;
  131. begin
  132.   i2:='                                  '; cls;
  133.   seek(vdata,qnum-1); read(vdata,vd);
  134.   if vd.numa=0 then print('Inactive question.') else begin
  135.     print('Question #'+cstr(qnum)+':');
  136.     print(vd.question);
  137.     tv:=0; for ii:=1 to vd.numa do tv:=tv+vd.answ[ii].numres;
  138.     print('Users voting: '+ctp(tv,systat.users)); if tv=0 then tv:=1;
  139.     nl; print('0:No Comment');
  140.     ij:='Q0';
  141.     for ii:=1 to vd.numa do begin
  142.       ij:=ij+cstr(ii);
  143.       i1:=copy(vd.answ[ii].ans,1,25);
  144.       i1:=i1+copy(i2,1,25-length(i1))+' :';
  145.       i:=copy(cstr(vd.answ[ii].numres),1,3);
  146.       i1:=i1+copy(i2,1,3-length(i))+i+' '+ctp(vd.answ[ii].numres,tv);
  147.       print(cstr(ii)+':'+i1);
  148.     end;
  149.     nl;nl;
  150.     i:='Your vote: '+vd.answ[thisuser.vote[qnum]].ans; print(i);
  151.     if not(rvoting in thisuser.ac) and (not hangup) and (thisuser.sl>10) then begin
  152.       prompt('Change it? '); if yn then begin
  153.         nl;prompt('Which number (0-'+cstr(vd.numa)+') ? '); onek(i[1],ij);
  154.         i[0]:=#1; ii:=value(i); if (i<>'') and (ii>=0) and (ii<=vd.numa) then begin
  155.           if thisuser.vote[qnum]<>0 then
  156.             vd.answ[thisuser.vote[qnum]].numres:=vd.answ[thisuser.vote[qnum]].numres-1;
  157.           thisuser.vote[qnum]:=ii;
  158.           if ii<>0 then vd.answ[ii].numres:=vd.answ[ii].numres+1;
  159.           seek(vdata,qnum-1); write(vdata,vd);
  160.           cls; print('Current Standings: '); nl; print(vd.question); nl;
  161.           tv:=0; for ii:=1 to vd.numa do tv:=tv+vd.answ[ii].numres;
  162.           print('Users voting: '+ctp(tv,systat.users)); nl; if tv=0 then tv:=1;
  163.           for ii:=1 to vd.numa do begin
  164.             i1:=copy(vd.answ[ii].ans,1,25);
  165.             i1:=i1+copy(i2,1,25-length(i1))+' :';
  166.             i:=copy(cstr(vd.answ[ii].numres),1,3);
  167.             i1:=i1+copy(i2,1,3-length(i))+i+' '+ctp(vd.answ[ii].numres,tv);
  168.             print(cstr(ii)+':'+i1);
  169.           end;
  170.         end;
  171.       end;
  172.     end;
  173.     dump;
  174.   end;
  175. end;
  176.  
  177. begin
  178.   i:=''; done:=false; lq:=true; helpl:='V';
  179.   assign(vdata,'gfiles\voting.dat');
  180.   {$I-} reset(vdata); {$I+}
  181.   if ioresult<>0 then print('No voting data found.') else
  182.   repeat
  183.     done:=false;
  184.     ij:='Q?';
  185.     abort:=false;
  186.     if lq then begin
  187.       cls; printacr('Current Questions:',abort,next); nl;
  188.     end;
  189.     int2:=0;
  190.     for int:=1 to 9 do begin
  191.       seek(vdata,int-1); read(vdata,vd);
  192.       if vd.numa<>0 then begin
  193.         int2:=int2+1;
  194.         if lq and not abort then begin
  195.           if thisuser.vote[int]=0 then i1:='* ' else i1:='  ';
  196.           i1:=i1+cstr(int)+': '+vd.question;
  197.           printacr(i1,abort,next);
  198.         end;
  199.         ij:=ij+cstr(int);
  200.       end;
  201.     end;
  202.     lq:=false;
  203.     if int2=0 then begin done:=true; print('No voting questions now.') end
  204.     else begin
  205.       nl; nl; prompt('Which question (#,Q,?) : '); onek(i[1],ij); i[0]:=#1;
  206.       int:=value(i); if i='Q' then done:=true; if i='?' then lq:=true;
  207.       if (int>0) and (int<10) then vote1(int);
  208.     end;
  209.   until done or hangup;
  210.   close(vdata);
  211. end;
  212.  
  213. overlay procedure logon;
  214. var fil:file of str; lo:array[1..8] of str; num:integer; i:str; ul:charfil; c:char;
  215.     abort:boolean;
  216. begin
  217.   realsl:=thisuser.sl; cls;nl;nl;
  218.   assign(fil,'gfiles\laston.fil');
  219.   reset(fil); for num:=1 to 8 do read(fil,lo[num]); close(fil);
  220.   print('Last few callers:');nl;
  221.   if cosysop in seclev[thisuser.sl].anst then for num:=1 to 8 do print(lo[num]) else
  222.     for num:=5 to 8 do print(lo[num]);
  223.   if realsl<>255 then begin
  224.     rewrite(fil); for num:=2 to 8 do write(fil,lo[num]);
  225.     i:=cstr(systat.callernum)+': '+nam;
  226.     write(fil,i); close(fil);
  227.   end;
  228.   print('You are caller #'+cstr(systat.callernum));
  229.   if thisuser.laston=date then thisuser.ontoday:=thisuser.ontoday+1
  230.     else thisuser.ontoday:=1;
  231.   if systat.lastdate<>date then begin
  232.     systat.lastdate:=date;
  233.     assign(ul,'gfiles\ysysop.log'); {$I-} erase(ul); {$I+} num:=ioresult; assign(ul,'gfiles\sysop.log');
  234.     rename(ul,'gfiles\ysysop.log');append(ul); writeln(ul,'Total Time On = '+
  235.       cstr(systat.activetoday)); writeln(ul,'Calls Today: '+cstr(systat.
  236.       callstoday)); writeln(ul,'Messages posted today: '+cstr(systat.
  237.       msgposttoday)); close(ul); rewrite(sysopf); writeln(sysopf); close(sysopf);
  238.     assign(ul,'gfiles\user.log'); rewrite(ul); writeln(ul); close(ul);
  239.     with systat do begin
  240.       activetoday:=0; callstoday:=0; msgposttoday:=0; emailtoday:=0;
  241.       fbacktoday:=0; uptoday:=0;
  242.     end;
  243.     enddayf:=true;
  244.   end;
  245.   if (realsl<>255) or incom then begin
  246.     append(sysopf);
  247.     writeln(sysopf,'');
  248.     writeln(sysopf,(cstr(systat.callernum)+': '+nam+' '+time+' '+date+'  '+spd+
  249.       '  - '+cstr(thisuser.ontoday))); close(sysopf);
  250.     if realsl<>255 then begin
  251.       assign(ul,'gfiles\user.log'); append(ul);
  252.       writeln(ul,cstr(systat.callernum)+': '+nam+'   '+spd+' - '+cstr(thisuser.ontoday)); close(ul);
  253.       systat.callernum:=systat.callernum+1; systat.callstoday:=systat.callstoday+1;
  254.     end;
  255.   end;
  256.   nl;nl; board:=1; expert:=false;
  257.   if thisuser.loggedon<2 then expert:=false else expert:=true;
  258.   mread:=0; extratime:=0; timeon:=timer; extramsgs:=0;
  259.   topscr; dump;
  260.   if incom then begin
  261.     printfile1('gfiles\logon.msg',abort);
  262.     if not abort then begin prompt('(-*-)'); getkey(c); end;
  263.   end;
  264.   readamsg;
  265.   reset(systatf); write(systatf,systat); close(systatf);
  266.   nl;nl;print('Name: '+nam);
  267.   print('Time allowed on: '+cstr(seclev[thisuser.sl].ttime));
  268.   if thisuser.waiting<>0 then print('Mail waiting   : '+cstr(thisuser.waiting));
  269.   if thisuser.illegal<>0 then print(chr(7)+'Illegal logons : '+cstr(thisuser.illegal));
  270.   if thisuser.laston<>date then print('Last on        : '+thisuser.laston)
  271.     else print('Times on today : '+cstr(thisuser.ontoday));
  272.   abort:=false;
  273.   for num:=1 to 9 do
  274.     if vqu[num] and (thisuser.vote[num]=0) then abort:=true;
  275.   if abort then print('You haven''t voted yet.');
  276.   nl;nl;mcursor;useron:=true; topscr;
  277.   if smw in thisuser.option then rsm;
  278.   thisuser.option:=thisuser.option-[smw];
  279.   if alert in thisuser.option then chatcall:=true;
  280.   if thisuser.waiting<>0 then begin
  281.     nl;nl;prompt('Read your mail now? ');
  282.     if yn then begin nl; readmail; end;
  283.     nl;nl;
  284.   end;
  285. end;
  286.  
  287. overlay procedure reqchat;
  288. begin
  289.   helpl:='C';
  290.   nl;nl; if (not sysop) or (rchat in thisuser.ac)
  291.   then begin
  292.     print('Sysop not available.');
  293.     print('Use Feedback instead.');
  294.     imail(1);
  295.   end else begin
  296.     if not chatcall then begin
  297.       prompt('Reason: '); inputl(i,70);
  298.       if i<>'' then begin
  299.         sysoplog('Chat: '+i);
  300.         print('Chat call now on.');
  301.         sound(440); delay(500); nosound;
  302.         chatr:=i; chatcall:=true;
  303.       end else chatr:='';
  304.     end else
  305.       begin chatcall:=false; print('Chat call turned off.'); chatr:='';end;
  306.   end;
  307.   nl;nl; topscr;
  308. end;
  309.  
  310. overlay procedure abbs;
  311. var filvar:charfil; i,i1:str; c:char; tf:text; there:boolean;
  312. begin
  313.   if not(ramsg in thisuser.ac) and (thisuser.sl>10) then begin
  314.     nl;prompt('Do you want to add to the bbs list? '); helpl:='A';
  315.     if yn then begin
  316.       repeat
  317.         print('Enter the phone number in the form:');
  318.         print(' ###-###-####');
  319.         prompt(':'); input(i1,12);
  320.       until (length(i1)=12) or (i1='') or hangup;
  321.       assign(tf,'gfiles\bbslist.msg'); there:=false;
  322.       {$I-} reset(tf); {$I+} if ioresult=0 then while not eof(tf) do begin
  323.         readln(tf,i); if copy(i,1,12)=i1 then there:=true;
  324.       end;
  325.       close(tf);
  326.       if there then begin nl;nl; print('It''s already in there.');
  327.         i1:=''; end;
  328.       i:=i1; if i<>'' then begin
  329.         print('Enter the name of the BBS:');
  330.         prompt(':'); inputl(i1,64);
  331.         i:=i+'  '+i1;
  332.         if i1<>'' then begin
  333.           nl;print(i); nl;prompt('Is this correct? ');
  334.           if yn then begin
  335.             assign(filvar,'gfiles\bbslist.msg'); {$I-} append(filvar); {$I+}
  336.             if ioresult<>0 then
  337.               rewrite(filvar);
  338.             writeln(filvar,i);
  339.             close(filvar);
  340.             sysoplog('Added "'+i+'"');
  341.           end;
  342.         end;
  343.       end;
  344.     end;
  345.   end;
  346. end;
  347.  
  348. overlay procedure yourinfo;
  349. begin
  350.   cls;
  351.   print('Your name      : '+nam);
  352.   print('Phone number   : '+thisuser.ph);
  353.   print('Mail waiting   : '+cstr(thisuser.waiting));
  354.   print('Sec Lev        : '+cstr(thisuser.sl));
  355.   print('Last on        : '+thisuser.laston);
  356.   print('Times on       : '+cstr(1+thisuser.loggedon));
  357.   print('On today       : '+cstr(thisuser.ontoday));
  358.   print('Messages posted: '+cstr(thisuser.msgpost));
  359.   print('E-mail sent    : '+cstr(thisuser.emailsent+thisuser.feedback));
  360.   prompt('Messages       : '); if rvalidate in thisuser.ac then
  361.     print('Unvalidated') else print('Validated');
  362.   prompt('Backspacing    : '); if rbackspace in thisuser.ac then
  363.     print('Off') else print('On');
  364. end;
  365.  
  366. overlay procedure prg(x:boolean);
  367. var q:boolean;
  368.  
  369. procedure purge(var quit:boolean);
  370. var pl,cn:integer; c:char; mr:messagerec; a,b:boolean;
  371. begin
  372.   quit:=false;
  373.   print('== Purge '+boards[board].name+' ==');
  374.   iscan(pl);
  375.   cn:=1;
  376.   while (cn<=pl) and (not quit) and (not hangup) do begin
  377.     seek(mf,cn); read(mf,mr);
  378.     if mr.owner<>usernum then cn:=cn+1 else begin
  379.       readm(cn,a,b,pl); nl;
  380.       prompt('D:elete, I:gnore, Q:uit :'); onek(c,'DIQ');
  381.       case c of
  382.         'D':begin deletem(pl,cn);
  383.               sysoplog('-'+mr.title+' purged off '+boards[board].name);
  384.             end;
  385.         'Q':begin quit:=true; cn:=pl+1; end;
  386.         'I':cn:=cn+1;
  387.       end;
  388.     end;
  389.   end;
  390.   close(mf);
  391.   print('== '+boards[board].name+' Purge Done ==');
  392. end;
  393.  
  394. procedure gpurge;
  395. var quit:boolean;
  396. begin
  397.   print('=== GLOBAL PURGE ===');
  398.   board:=1; repeat
  399.     if (thisuser.sl>=boards[board].sl) and
  400.       ((boards[board].ar='@') or (boards[board].ar in thisuser.ar)) then
  401.         purge(quit);
  402.     board:=board+1;
  403.   until (board>numboards) or hangup or quit;
  404.   board:=1;
  405.   print('=== GLOBAL PURGE DONE ===');
  406. end;
  407.  
  408. begin
  409.   helpl:='J';
  410.   if x then gpurge else purge(q);
  411. end;
  412.  
  413. overlay procedure wamsg;
  414. var filvar:text; i,n:str; ii:integer; li:array[1..3] of str;
  415. begin
  416.  readamsg; helpl:='W';
  417.  if not (ramsg in thisuser.ac) and (thisuser.sl>10) then begin
  418.   prompt('Change auto-message? ');
  419.   if yn then begin
  420.     nl;print('Enter three lines:'); nl;
  421.     for ii:=1 to 3 do begin
  422.       prompt(cstr(ii)+':'); inputl(li[ii],37);
  423.     end;
  424.     n:=nam; if pana in seclev[thisuser.sl].anst then begin
  425.       nl;prompt('Anonymous? ');
  426.       if yn then n:='@'+n;
  427.     end;
  428.     prompt('Is this alright? ');
  429.     if yn then begin
  430.       assign(filvar,'gfiles\auto.msg');
  431.       rewrite(filvar); writeln(filvar,n);
  432.       for ii:=1 to 3 do writeln(filvar,li[ii]);
  433.       close(filvar); print('Auto-message saved.');
  434.       if (realsl<>255) or incom then begin
  435.         append(sysopf); writeln(sysopf,'   Changed Auto-message');
  436.         for ii:=1 to 3 do writeln(sysopf,'      '+li[ii]); close(sysopf);
  437.       end;
  438.     end else prompt('Nothing saved.');
  439.   end;
  440.  end;
  441. end;
  442.  
  443. overlay procedure removem;
  444. var b:messagerec; pl,t:integer; i:str;
  445. begin
  446.   print('You have the following messages posted:');
  447.   iscan(pl); helpl:='R';
  448.   for t:=1 to pl do begin
  449.     seek(mf,t); read(mf,b);
  450.     if b.owner=usernum then
  451.       print(cstr(t)+': '+b.title);
  452.   end; prompt('Message to remove? ');
  453.   input(i,3); t:=value(i);
  454.   if t<>0 then
  455.     if (t<1) or (t>pl) then
  456.         print('Illegal number') else begin
  457.         seek(mf,t); read(mf,b); if (b.owner<>usernum) and
  458.         not lcs then
  459.           print('You didn''t write it.') else begin
  460.             print(cstr(t)+': '+b.title); prompt('Remove it? ');
  461.             if yn then begin
  462.               deletem(pl,t); print('Removed.');
  463.               sysoplog('-'+b.title+' deleted off of '+boards[board].name);
  464.             end;
  465.           end;
  466.         end;
  467.   close(mf);
  468. end;
  469.  
  470. overlay procedure boardlist;
  471. var b:integer; i:str; abort,next:boolean;
  472. begin
  473.   nl;nl; print('Boards available to you:'); print('');
  474.   b:=1; abort:=false;
  475.   while (b<=numboards) and (not abort) do begin
  476.     if boardac(b) then begin
  477.        if boards[b].key=' ' then i:=cstr(b)
  478.        else i:=boards[b].key;
  479.        if length(i)=1 then i:=' '+i;
  480.        i:=i+' : '+boards[b].name;
  481.        printacr(i,abort,next);
  482.     end;
  483.     b:=b+1;
  484.   end;
  485.   nl;nl;
  486. end;
  487.  
  488. overlay procedure newuser;
  489. var c:char; tries,i,ii,t:integer; s,s1,s2:str; tf:boolean; fi:text; pasw:str;
  490. begin
  491.  sl1('*** NEW USER *** '+time+' '+date);
  492. if systat.users>=maxusers then begin
  493.   print('Sorry, there are the maximum number');
  494.   print('of users already.');
  495.   hangup:=true;
  496. end else begin
  497.  if incom then begin
  498.    nl;nl;printfile('gfiles\system.msg');
  499.    nl;nl;printfile('gfiles\newuser.msg');
  500.    tries:=0; pasw:='';
  501.    while (systat.boardpw<>pasw) and (not hangup) do begin
  502.      prompt('Newuser password :'); input(pasw,38); tries:=tries+1;
  503.      if (pasw='OFF') or (pasw='BYE') then tries:=4;
  504.      if tries>=4 then
  505.        hangup:=true
  506.      else
  507.        if (systat.boardpw<>pasw) and (pasw<>'') then
  508.          sl1('Wrong newuser password: '+pasw);
  509.    end;
  510.  end;
  511.  repeat
  512.   t:=0;
  513.   repeat
  514.     print('Enter your full name, or your alias.');
  515.     prompt(':'); input(thisuser.name,25); tf:=false;
  516.     if (thisuser.name='BYE') or (thisuser.name='OFF') then hangup:=true; nl;
  517.     if (thisuser.name[1]<'A') or (thisuser.name='') then tf:=true;
  518.     for i:=1 to systat.users do if srl[i].name=thisuser.name then tf:=true;
  519.     assign(fi,'gfiles\trashcan.txt');{$I-} reset(fi); {$I+}
  520.     if ioresult=0 then begin
  521.       s2:=' '+thisuser.name+' ';
  522.       while not eof(fi) do begin
  523.         readln(fi,s1); if s1[length(s1)]=#1 then s1[length(s1)]:=' ' else s1:=s1+' ';
  524.         s1:=' '+s1; for i:=1 to length(s1) do s1[i]:=upcase(s1[i]);
  525.         if pos(s1,s2)<>0 then tf:=true;
  526.       end;
  527.       close(fi);
  528.     end;
  529.     if tf then begin
  530.       print(chr(7)+'Sorry, can''t use that name.');
  531.       t:=t+1;
  532.       sl1('Unacceptable name     : '+thisuser.name);
  533.     end;
  534.     if t>=3 then hangup:=true;
  535.   until (tf=false) or hangup;
  536.   print('Enter your VOICE phone number in the');
  537.   print('form:');
  538.   print(' ###-###-####.'); prompt(':');
  539.   input(thisuser.ph,12);
  540.   nl; print('Enter your REAL first name.');
  541.   prompt (':');
  542.   inputl(thisuser.realname,14);
  543.   nl; print('Which computer type do you have?');
  544.   for i:=1 to 8 do
  545.     print(cstr(i)+'. '+comptyp[i]);
  546.   nl; prompt('Which? ');
  547.   onek(c,'12345678');
  548.   thisuser.comptype:=value(c); nl; nl;
  549.   print('['+thisuser.name+'] ['+thisuser.realname+']');
  550.   print('['+thisuser.ph+'] ['+comptyp[thisuser.comptype]+']');
  551.   c:='Y'; if (length(thisuser.ph)<>12) or (thisuser.ph[4]<>'-') or
  552.     (thisuser.ph[8]<>'-') then begin print('Enter the phone number right!'); c:='N'; end;
  553.   if thisuser.realname='' then c:='N';
  554.   nl; if c='Y' then begin dump; prompt('Is this correct? ');
  555.   if yn then c:='Y' else c:='N'; end else
  556.     print('Please use proper format.');
  557.  until (c='Y') or hangup;
  558.  if not hangup then begin
  559.  with thisuser do begin
  560.   deleted:=false; waiting:=0; laston:='Never.';loggedon:=0; msgpost:=0;
  561.   emailsent:=0; feedback:=0; linelen:=80; pagelen:=25;
  562.   defaults:=[onekey,wordwrap]; ontoday:=0; illegal:=0; cursor:='/>\<';
  563.   option:=[];dsl:=0; downloads:=0; uploads:=0; uk:=0; dk:=0;
  564.   if incom then sl:=10 else sl:=30;
  565.   ac:=[rvalidate]; ar:=[]; for i:=1 to 9 do vote[i]:=0; qscan[1].ext:=1;
  566.   qscan[1].ltr:='A'; qscan[1].number:=-32767;
  567.   for i:=2 to 19 do qscan[i]:=qscan[1];
  568.   for i:=1 to 19 do qscn[i]:=true;
  569.  end;
  570.  thisuser.macro[1]:='THIS IS THE CTRL-D MACRO';
  571.  thisuser.macro[2]:='THIS IS THE CTRL-F MACRO';
  572.  thisuser.sbn:=0;
  573.  randomize;
  574.  thisuser.pw:='';
  575.  for i:=1 to 6 do begin
  576.    ii:=random(36);
  577.    if ii<10 then c:=chr(ord('0')+ii)
  578.      else c:=chr(ord('A')+ii-10);
  579.    thisuser.pw:=thisuser.pw+c;
  580.  end;
  581.  reset(uf);
  582.  ii:=0; for i:=1 to filesize(uf)-1 do begin
  583.    seek(uf,i);
  584.    read(uf,user);
  585.    if user.deleted and (ii=0) then ii:=i;
  586.  end;
  587.  if ii=0 then usernum:=filesize(uf) else usernum:=ii;
  588.  seek(uf,usernum);
  589.  write(uf,thisuser);
  590.  close(uf);
  591.  isr(thisuser.name,usernum); nl; nl;
  592.  repeat
  593.    print('Your user number is '+cstr(usernum));
  594.    print('Your password is "'+thisuser.pw+'".');
  595.    print('Please write them down and re-type');
  596.    print('your password for verification.');
  597.    prompt('Password: '); input(s,8);
  598.  until (s=thisuser.pw) or hangup;
  599.  nl; nl;
  600.  if incom then begin
  601.    topscr;
  602.    print('You will now send a letter to the sysop');
  603.    print('asking for validation.  If you do not');
  604.    print('complete it, you will not be validated.');
  605.    irt:='New User Application';
  606.    nl; email(1);
  607.  end;
  608. end;
  609. end;
  610. end;
  611.  
  612. overlay procedure delmail;
  613. var tu,d,i,x:integer; mr:mailrec; f:file; u:userrec; c:char; abort,next,done:boolean;
  614. begin
  615.   helpl:='K';
  616.   prompt('Kill old E-mail? '); if yn then begin
  617.   nl;nl;d:=daynum(date); reset(uf); reset(mailfile);i:=0; done:=false;
  618.   while (i<filesize(mailfile)) and (not hangup) and (not done) do begin
  619.     seek(mailfile,i); read(mailfile,mr);
  620.     if (abs(mr.from)=usernum) and (mr.destin<>-1) then repeat
  621.       tu:=mr.destin; seek(uf,tu); read(uf,u);
  622.       nl;print('To   : '+u.name+' #'+cstr(tu));
  623.       print('Title: '+mr.title);
  624.       print('Sent : '+cstr(d-mr.date)+' days ago');
  625.       nl; prompt('R:ead, D:elete, N:ext, Q:uit : ');
  626.       onek(c,'QNDR');
  627.       case c of
  628.         'Q':done:=true;
  629.         'D':begin
  630.               close(uf); sysoplog('Deleted mail to '+rmail(i)); reset(uf);
  631.               if tu=usernum then thisuser.waiting:=thisuser.waiting-1;
  632.               print('Mail deleted.');
  633.             end;
  634.         'R':begin nl; nl; readmsg(mr.msg,abort,next);end;
  635.       end;
  636.     until hangup or (c<>'R');
  637.     i:=i+1;
  638.   end;
  639.   close(uf); close(mailfile); topscr;
  640.  end;
  641. end;
  642.  
  643. overlay procedure gfiles;
  644. var b:gft; f:file of gft; i:str; t,c:integer; deep,exit:boolean;
  645.     gftit:array[1..150] of record tit:string[80]; arn:integer; gfile:boolean;end;
  646.     lgftn,lgftnt,numgft:integer; titl:str;
  647.  
  648.   procedure gettit(n:integer);
  649.   var r:integer; b:gft;
  650.   begin
  651.     numgft:=0;
  652.     if n>0 then begin
  653.       seek(f,n); read(f,b); titl:='[ '+b.title+' ]';
  654.     end else titl:='[ Main Section ]';
  655.     r:=n+1;
  656.     if r<=t then begin
  657.       seek(f,r); read(f,b);
  658.       while (r<=t) and (b.filen[1]<>#1) do begin
  659.         if b.num<=thisuser.sl then begin
  660.           numgft:=numgft+1;
  661.           gftit[numgft].tit:=b.title;
  662.           gftit[numgft].arn:=r;
  663.           gftit[numgft].gfile:=true;
  664.         end;
  665.         r:=r+1;
  666.         if (r<=t) then begin seek(f,r); read(f,b); end;
  667.       end;
  668.     end;
  669.     if n=0 then
  670.       while (r<=t) do begin
  671.         seek(f,r); read(f,b);
  672.         if (b.filen[1]=#1) and (b.num<=thisuser.sl) then begin
  673.           numgft:=numgft+1;
  674.           gftit[numgft].tit:='[ '+b.title+' ]';
  675.           gftit[numgft].arn:=r;
  676.           gftit[numgft].gfile:=false;
  677.         end;
  678.         r:=r+1;
  679.       end;
  680.   end;
  681.  
  682.   procedure lgft;
  683.   var abort,next:boolean; c:integer;
  684.   begin
  685.     nl; print(titl); nl;
  686.     if numgft=0 then print('No G-files.') else begin
  687.       abort:=false; next:=false; c:=1;
  688.       while (c<=numgft) and (not abort) do begin
  689.         printacr(cstr(c)+': '+gftit[c].tit,abort,next);
  690.         c:=c+1;
  691.       end;
  692.     end;
  693.   end;
  694.  
  695. begin
  696.   nl;assign(f,'gfiles\gfiles.dat'); {$I-} reset(f); {$I+}
  697.   if ioresult<>0 then begin
  698.     rewrite(f); b.num:=0; write(f,b);
  699.   end;
  700.   seek(f,0); read(f,b); t:=b.num; helpl:='G';
  701.   if t=0 then print('No G-files yet.') else begin
  702.     gettit(0); exit:=false;
  703.     lgft; lgftn:=0; deep:=false; lgftnt:=0;
  704.     repeat
  705.       nl; nl; prompt('Gfiles: (1-'+cstr(numgft)+', ^'+cstr(lgftn)+'),?,Q : ');
  706.       input(i,3);
  707.       if i='' then if lgftn=numgft then i:='Q' else i:=cstr(lgftn+1);
  708.       if i='?' then lgft;
  709.       if i='Q' then
  710.         if deep then begin
  711.           deep:=false;
  712.           gettit(0);
  713.           lgft;
  714.           lgftn:=lgftnt;
  715.         end else exit:=true;
  716.       c:=value(i);
  717.       if (c>0) and (c<=numgft) then begin
  718.         if gftit[c].gfile=true then begin
  719.           seek(f,gftit[c].arn);
  720.           read(f,b);
  721.           printfile('gfiles\'+b.filen);
  722.           lgftn:=c;
  723.         end else begin
  724.           gettit(gftit[c].arn);
  725.           lgftn:=c;
  726.           if numgft>0 then begin
  727.             lgft;
  728.             lgftnt:=c; lgftn:=0;
  729.             deep:=true;
  730.           end else begin
  731.             gettit(0);
  732.             nl; print('No G-files there.');
  733.           end;
  734.         end;
  735.       end;
  736.     until exit or hangup;
  737.   end;
  738.   close(f);
  739.   nl;nl;
  740. end;
  741.  
  742. overlay procedure chpw;
  743. var i:str;
  744. begin
  745.   cls; print('Your current password is "'+thisuser.pw+'"');
  746.   print('If you change it, it must be between');
  747.   print('three and eight characters. Do you want');
  748.   helpl:='Z';
  749.   prompt('To change it? ');
  750.   if yn then begin
  751.    repeat
  752.     print('Enter new password:'); print(' (-!----)'); prompt(':');
  753.     input(i,8);
  754.    until (length(i)>2) or hangup;
  755.    print('New password="'+i+'"');
  756.    if not hangup then thisuser.pw:=i;
  757.    sysoplog('Changed password.');
  758.   end;
  759.   topscr;
  760. end;
  761.  
  762. overlay procedure mmacro;
  763. var i:str; c,mc:char; mcn,n,n1,mn:integer; done:boolean;
  764. begin
  765.   done:=false; helpl:='H';
  766.   repeat
  767.     nl; prompt('Macros: M,L,Q,? :'); onek(c,'MLQ?');
  768.     case c of
  769.       '?':begin
  770.             print('M:ake macro    L:ist macros');
  771.             print('Q:uit          ?:this');
  772.           end;
  773.       'Q':done:=true;
  774.       'L':begin
  775.             nl; print('Current Macros:');
  776.             for n:=1 to 2 do begin nl;
  777.               if n=1 then print('Ctrl-D:') else print('Ctrl-F:');
  778.               prompt('"');
  779.               for n1:=1 to length(thisuser.macro[n]) do
  780.                 if thisuser.macro[n][n1]>=' ' then
  781.                   prompt(thisuser.macro[n][n1])
  782.                 else
  783.                   prompt('^'+chr(64+ord(thisuser.macro[n][n1])));
  784.               print('"');
  785.             end;
  786.           end;
  787.       'M':begin
  788.             nl; prompt('Which (D,F,Q=Quit) :'); onek(c,'DFQ');
  789.             if c<>'Q' then begin
  790.               nl;nl; mc:=c; print('Enter your macro now, Ctrl-'+mc);
  791.               print('to end macro.'); nl;if mc='D' then mcn:=4 else mcn:=6;
  792.               n:=1; i:=''; macok:=false; if mc='D' then mn:=1 else mn:=2;
  793.               helpl:=#0;
  794.               repeat
  795.                 getkey(c);
  796.                 if ord(c)>127 then c:=chr(0);
  797.                 if (ord(c)<32) then
  798.                   if not((c=#8) or (c=#10) or (c=#13) or (c=#14) or (c=#9) or
  799.                          (c=#24) or (c=chr(mcn))) then c:=chr(0);
  800.                   if c=#8 then if n<2 then c:=#0 else begin
  801.                     bs; oc(#8); n:=n-1; c:=#0;
  802.                   end;
  803.                 if (c<>#0) and (c<>chr(mcn)) then begin
  804.                   if (c=#21) or (c=#14) or (c=#9) or (c=#24) then prompt('^'+chr(ord(c)+64))
  805.                   else oc(c);
  806.                   i[n]:=c; n:=n+1;
  807.                   if c=#13 then oc(chr(10));
  808.                 end;
  809.               until (c=chr(mcn)) or (n=80) or hangup;
  810.               nl; helpl:='H';
  811.               if n=80 then begin
  812.                 print('Macro limit is 79 chars.');
  813.                 print('That much saved.');
  814.               end;
  815.               i[0]:=chr(n-1);
  816.               print('Ctrl-'+mc+' macro is now:'); prompt('"');
  817.               for n1:=1 to length(i) do
  818.                 if i[n1]>=' ' then
  819.                   prompt(i[n1])
  820.                 else
  821.                   prompt('^'+chr(64+ord(i[n1])));
  822.               print('"'); dump;
  823.               prompt('Is this what you want? ');
  824.               if yn then begin thisuser.macro[mn]:=i; print('Macro saved.') end
  825.               else print('Macro not saved, then.');
  826.               macok:=true;
  827.             end;
  828.           end;
  829.     end;
  830.   until done or hangup;
  831. end;
  832.  
  833. overlay procedure default;
  834. var c:char; i:str; i1,ii:integer;
  835. begin
  836.  c:='?';
  837.  repeat
  838.  if c='?' then begin
  839.   print(chr(12)+'Your defaults:');nl;
  840.   print('1. Screen size    : '+cstr(thisuser.linelen)+'X'+cstr(thisuser.pagelen));
  841.   prompt('2. Cursor         : ');
  842.     if spcsr in thisuser.defaults then print(thisuser.cursor) else
  843.       print('Standard');
  844.   prompt('3. Input          : ');
  845.     if onekey in thisuser.defaults then print('One key') else print('Line');
  846.   prompt('4. Wordwrap       : ');
  847.     if wordwrap in thisuser.defaults then print('On') else print('Off');
  848.   prompt('5. Pause on screen: '); if pause in thisuser.defaults then
  849.     print('On') else print('Off');
  850.   prompt('6. Mailbox        : '); if nomail in thisuser.option then begin
  851.     print('Closed'); print('   You can not receive mail'); end else print('Open');
  852.   print('7. Configured Q-scan');
  853.  end;
  854.   nl;nl; helpl:='D'; prompt('Enter number to change, Q or ? :');
  855.   onek(c,'Q1234567?');nl;
  856.   case c of
  857.     '1':begin
  858.           nl;nl;prompt('Number of characters per line? ');
  859.           input(i,2); if i<>'' then thisuser.linelen:=value(i);
  860.           if thisuser.linelen>80 then thisuser.linelen:=80;
  861.           if thisuser.linelen<32 then thisuser.linelen:=32;
  862.           prompt('Number of lines per page? ');
  863.           input(i,2); if i<>'' then thisuser.pagelen:=value(i);
  864.           if thisuser.pagelen>25 then thisuser.pagelen:=25;
  865.           if thisuser.pagelen<4 then thisuser.pagelen:=4;
  866.         end;
  867.     '2':begin
  868.           nl;nl; prompt('Do you want a spinning cursor? ');
  869.           if yn then thisuser.defaults:=thisuser.defaults+[spcsr]
  870.           else thisuser.defaults:=thisuser.defaults-[spcsr];
  871.           if spcsr in thisuser.defaults then begin
  872.             print('Current Cursor: '+thisuser.cursor);
  873.             print('Enter new cursor, or <CR> to leave it.');
  874.             print(' (--------)');
  875.             prompt(':'); inputl(i,10); if i<>'' then thisuser.cursor:=i;
  876.             mcursor;
  877.           end;
  878.         end;
  879.     '3':begin
  880.           if not (onekey in thisuser.defaults) then begin
  881.             thisuser.defaults:=thisuser.defaults+[onekey]; print('Turned on.'); end
  882.           else begin
  883.             thisuser.defaults:=thisuser.defaults-[onekey]; print('Turned off.'); end
  884.         end;
  885.     '4':begin
  886.           if not (wordwrap in thisuser.defaults) then begin
  887.             thisuser.defaults:=thisuser.defaults+[wordwrap]; print('Turned on.'); end
  888.           else begin
  889.             thisuser.defaults:=thisuser.defaults-[wordwrap]; print('Turned off.'); end;
  890.         end;
  891.     '5':if pause in thisuser.defaults then
  892.            begin thisuser.defaults:=thisuser.defaults-[pause];
  893.            print('Turned off.'); end else
  894.            begin thisuser.defaults:=thisuser.defaults+[pause];
  895.            print('Turned on.'); end;
  896.     '6':if nomail in thisuser.option then begin
  897.            thisuser.option:=thisuser.option-[nomail];
  898.            print('Mailbox now open.'); print('You can receive mail now.');
  899.          end else begin
  900.            thisuser.option:=thisuser.option+[nomail];
  901.            print('Mailbox now closed.'); print('You >CAN NOT< recieve mail now.');
  902.          end;
  903.     '7':repeat
  904.           helpl:='I';
  905.           nl;nl;print('boards to Q-scan marked with ''*''');
  906.           nl; for ii:=1 to numboards do if boardac(ii) then begin
  907.             if thisuser.qscn[ii] then prompt('*  ') else prompt('   ');
  908.             if boards[ii].key=' ' then i:=cstr(ii) else i:=boards[ii].key;
  909.             if length(i)=1 then i:=' '+i;
  910.             i:=i+' : '+boards[ii].name;print(i);
  911.           end;
  912.           repeat
  913.            prompt('Enter board #, Q, or ? :'); input(i,2);
  914.            ii:=value(i);
  915.            if (ii>0) and (ii<=numboards) then
  916.              if (boards[ii].key=' ') and boardac(ii) then thisuser.qscn[ii]:=
  917.                not thisuser.qscn[ii]
  918.              else
  919.            else begin
  920.              i1:=0;
  921.              for ii:=1 to numboards do if boards[ii].key=i then i1:=ii;
  922.              if (i1<>0) and (i<>' ') then if boardac(ii) then
  923.                thisuser.qscn[ii]:=not thisuser.qscn[ii];
  924.            end;
  925.           until (i='Q') or (i='?') or hangup;
  926.         until (i='Q') or hangup;
  927.   end;
  928.  until hangup or (c='Q');
  929.  topscr;
  930. end;
  931.  
  932. overlay procedure logoff;
  933. var s,d:integer; mr:mailrec; x:smr;
  934. begin
  935.   term_ready(false);
  936.   thisuser.laston:=systat.lastdate;
  937.   thisuser.loggedon:=thisuser.loggedon+1;
  938.   thisuser.sl:=realsl;
  939.   thisuser.illegal:=0;
  940.   reset(uf); seek(uf,usernum); write(uf,thisuser); close(uf);
  941.   systat.activetoday:=systat.activetoday+trunc((timer-timeon+30)/60);
  942.   systat.fbacktoday:=systat.fbacktoday+ftoday;
  943.   systat.emailtoday:=systat.emailtoday+etoday;
  944.   reset(systatf); write(systatf,systat); close(systatf);
  945.   window(1,1,80,25);clrscr;
  946.   if hungup then sysoplog('*** HUNG UP ***');
  947.   sysoplog('Read: '+cstr(mread)+'   Time on: '+cstr(trunc((timer-timeon+30)/60)));
  948.   {$I-}  reset(mailfile) {$I+}; if ioresult=0 then
  949.    if filesize(mailfile)>1 then begin
  950.     s:=0; d:=0;
  951.     while s<filesize(mailfile) do begin
  952.       seek(mailfile,s); read(mailfile,mr);
  953.       if (mr.destin<>-1) then
  954.         if s=d then d:=d+1 else begin
  955.           seek(mailfile,d); write(mailfile,mr); d:=d+1;
  956.         end;
  957.       s:=s+1;
  958.     end;
  959.     mr.destin:=-1; mr.from:=-1;
  960.     for s:=d to filesize(mailfile)-1 do begin
  961.       seek(mailfile,s); write(mailfile,mr);
  962.     end;
  963.   end;
  964.   close(mailfile);
  965.   {$I-}  reset(smf) {$I+}; if ioresult=0 then
  966.    if filesize(smf)>1 then begin
  967.     s:=0; d:=0;
  968.     while s<filesize(smf) do begin
  969.       seek(smf,s); read(smf,x);
  970.       if x.destin<>-1 then
  971.         if s=d then d:=d+1 else begin
  972.           seek(smf,d); write(smf,x); d:=d+1;
  973.         end;
  974.       s:=s+1;
  975.     end;
  976.     x.destin:=-1;
  977.     for s:=d to filesize(smf)-1 do begin
  978.       seek(smf,s); write(smf,x);
  979.     end;
  980.   end;
  981.   close(smf);
  982. end;
  983.  
  984. overlay procedure endday;
  985. var cn,pl,d,i,tu,fu:integer; mr:mailrec; f:file; u:userrec; b:messagerec; is:str;
  986. begin
  987.   d:=daynum(date); reset(mailfile);
  988.   for i:=0 to filesize(mailfile)-1 do begin
  989.     seek(mailfile,i); read(mailfile,mr);
  990.     if (d-mr.date>mr.mage) and (mr.destin<>-1) then begin
  991.       fu:=abs(mr.from);
  992.       is:=rmail(i);
  993.       ssm(fu,is+' never got your letter.');
  994.     end;
  995.   end;
  996.   close(mailfile);
  997.   reset(uf);
  998.   for board:=1 to numboards do begin
  999.     iscan(pl);
  1000.     cn:=1;
  1001.     while cn<=pl do begin
  1002.       seek(mf,cn); read(mf,b);
  1003.       if ((d-b.date>b.mage) or (b.messagestat=deleted)) and (b.date>0) then
  1004.         deletem(pl,cn)
  1005.       else
  1006.         cn:=cn+1;
  1007.     end;
  1008.     close(mf);
  1009.   end;
  1010.   close(uf);
  1011. end;
  1012.  
  1013. overlay procedure smail(tf:boolean);
  1014. var ix,c1,c2,c3,c4:integer; c:char;
  1015.     mr:mailrec; t,e,cp:integer; f:messages; a:anontyp; i:str; us:userrec;
  1016.     na:array[1..20] of integer; abort,ok:boolean;
  1017. begin
  1018.   if tf=false then begin
  1019.     irt:=''; helpl:='Q';
  1020.     print('Enter user name or number.'); prompt(':');
  1021.     finduser(ix);
  1022.     if ix>0 then
  1023.       imail(ix);
  1024.   end else if not((remail in thisuser.ac) or
  1025.     ((etoday>=seclev[thisuser.sl].emails) and (thisuser.sl<55))) then begin
  1026.     reset(uf); helpl:='E'; irt:='';
  1027.     repeat
  1028.       nl; nl; print('Send mail to more than one user.'); ok:=false;
  1029.       print('Enter user NUMBERS, separated by commas, max 20.');
  1030.       prompt(':'); input(i,78); abort:=(i='');
  1031.       for c1:=1 to 20 do na[c1]:=0;
  1032.       c1:=1; c2:=1;
  1033.       while i<>'' do begin
  1034.         c3:=pos(',',i);
  1035.         if c3=0 then c3:=length(i)+1;
  1036.         c4:=value(copy(i,1,c3-1));
  1037.         i:=copy(i,c3+1,length(i)-c3);
  1038.         if (c4<1) or (c4>maxusers) or (c4>=filesize(uf)) then c4:=0;
  1039.         if c4<>0 then begin
  1040.           seek(uf,c4); read(uf,us);
  1041.           if us.deleted or ((c4=1) and (us.waiting>50)) or ((c4<>1) and
  1042.             (us.waiting>15)) or ((nomail in us.option) and not cs) or
  1043.             ((c4=usernum) and (realsl<>255)) then
  1044.               c4:=0;
  1045.           if not cs then
  1046.             for c2:=1 to 20 do
  1047.               if na[c2]=c4 then
  1048.                 c4:=0;
  1049.           if (c4<>0) and (c1<=20) then begin
  1050.             na[c1]:=c4;
  1051.             c1:=c1+1;
  1052.           end;
  1053.         end;
  1054.       end;
  1055.       if not abort then begin
  1056.         nl; print('Users marked:');
  1057.         c1:=1;
  1058.         while (na[c1]<>0) and (c1<=20) do begin
  1059.           seek(uf,na[c1]); read(uf,us); print('  '+us.name+' #'+cstr(na[c1]));
  1060.           c1:=c1+1;
  1061.         end;
  1062.         if na[1]=0 then print('  None');
  1063.         nl; prompt('Is this correct? ');  ok:=yn;
  1064.       end else ok:=true;
  1065.     until ok;
  1066.     if na[1]<>0 then begin
  1067.       a:=no; if sanm in seclev[thisuser.sl].anst then a:=yes;
  1068.       inmsg(f,a,i,false,true);
  1069.       if f.ext<>0 then begin
  1070.         {$I-} reset(mailfile); {$I+}
  1071.         if (ioresult<>0) then
  1072.           rewrite(mailfile);
  1073.         e:=filesize(mailfile);
  1074.         if e=0 then cp:=0 else begin
  1075.           cp:=-1; t:=e-1;
  1076.           seek(mailfile,t); read(mailfile,mr);
  1077.           while (t>0) and (mr.destin=-1) do begin
  1078.             t:=t-1; seek(mailfile,t); read(mailfile,mr);
  1079.           end;
  1080.           cp:=t+1;
  1081.         end;
  1082.         seek(mailfile,cp);
  1083.         if (realsl<>255) or incom then begin
  1084.           assign(sysopf,'gfiles\sysop.log'); {$I-} append(sysopf);{$I+}
  1085.           if ioresult<>0 then
  1086.             rewrite(sysopf);
  1087.         end;
  1088.         mr.msg:=f; if lan then mr.from:=-usernum else mr.from:=usernum;
  1089.         mr.title:=i; mr.date:=daynum(date);
  1090.         mr.mage:=maxage(thisuser.sl);
  1091.         c1:=1; nl; print('Sending mail to:');
  1092.         while (na[c1]<>0) and (c1<=20) do begin
  1093.           mr.destin:=na[c1];
  1094.           write(mailfile,mr);
  1095.           if na[c1]=1 then begin
  1096.             thisuser.feedback:=thisuser.feedback+1;
  1097.             ftoday:=ftoday+1;
  1098.             fw:=fw+1;
  1099.           end else begin
  1100.             thisuser.emailsent:=thisuser.emailsent+1;
  1101.             etoday:=etoday+1;
  1102.           end;
  1103.           seek(uf,na[c1]); read(uf,us);
  1104.           us.waiting:=us.waiting+1; seek(uf,na[c1]); write(uf,us);
  1105.           if na[c1]=usernum then thisuser.waiting:=thisuser.waiting+1;
  1106.           i:=us.name+' #'+cstr(na[c1]);
  1107.           if (realsl<>255) or incom then
  1108.             writeln(sysopf,'   Mult-mail sent to '+i);
  1109.           print('  '+i);
  1110.           c1:=c1+1;
  1111.         end;
  1112.         close(sysopf); close(mailfile); topscr;
  1113.       end;
  1114.     end;
  1115.     close(uf);
  1116.   end;
  1117. end;
  1118.  
  1119. overlay procedure ulist;
  1120. var inte:integer; abort,next:boolean;
  1121. begin
  1122.   inte:=0; abort:=false; while (not abort) and (inte<systat.users) do begin
  1123.     inte:=inte+1;
  1124.     printacr(srl[inte].name+' #'+cstr(srl[inte].number),abort,next);
  1125.   end;
  1126. end;
  1127.  
  1128. overlay procedure dloads;
  1129. var f:file; ok:boolean;
  1130. begin
  1131.   ok:=true;
  1132.   if (thisuser.sl<=10) or (thisuser.dsl=0) then ok:=false;
  1133.   if cs then ok:=true;
  1134.   if not ok then print('You can''t access the file system.') else
  1135.   begin
  1136.     assign(f,'dloads.chn');
  1137.     {$I-} reset(f); {$I+}
  1138.     if ioresult=0 then begin
  1139.       print('Loading file system...');
  1140.       close(f);
  1141.       remove_port;
  1142.       chain(f);
  1143.     end else print('File system not present.');
  1144.   end;
  1145. end;
  1146.  
  1147. overlay procedure pver;
  1148. var abort,next:boolean;
  1149. begin
  1150.   nl; nl;
  1151.   abort:=false;
  1152.   printacr('WWIV BBS system, version 3.11',abort,next);
  1153.   nl;
  1154.   printacr('Please address donations to:',abort,next);
  1155.   printacr(' ',abort,next);
  1156.   printacr('   Wayne Bell',abort,next);
  1157.   printacr('   Box 636',abort,next);
  1158.   printacr('   904 Silver Spur Road',abort,next);
  1159.   printacr('   Rolling Hills Estates, CA  90274',abort,next);
  1160.   nl;
  1161. end;
  1162.